perm filename CONV.F4[MSS,LCS] blob sn#097576 filedate 1974-04-12 generic text, type T, neo UTF8
00100		COMMON/LL/L
00200		DIMENSION MM(2000),IB(200),ITOP(10)
00300		DO 100 K=1,10
00400	100	ITOP(K)=0
00500		TYPE 1
00600		KJ=1
00700		KN=1
00800		ITOP(1)=1
00900	1	FORMAT(' TYPE FILE NAME --  '$)
01000	3	FORMAT(3I)
01100	2	FORMAT(A5)
01200		ACCEPT 2,NM
01300		CALL IFILE(1,NM)
01400	14	CALL DPYSET(1,IB,200)
01440		KM=KJ
01500	5	READ(1,3)J,K,L
01600		IF(L.EQ.0)GO TO 7
01700	C  L=0=END OF ITEM
01800		IF(L.NE.3)GO TO 4
01900		CALL AIVECT(J,K)
02000		L=100000000
02100		GO TO 6
02200	4	CALL AVECT(J,K)
02300	
02400	
02500	6	KJ=KJ+1
02600		CALL REPACK(KJ,J/9,K/9,MM)
02650	C  /9  BECAUSE DRAWING PROG. MULTS BY 9
02700		GO TO 5
02800	
02900	7	FORMAT(' KEEP IT?  '$)
03000		CALL DPYOUT(1)
03100		TYPE 7
03200		ACCEPT 2,IA
03300		IF(IA.EQ.'N')GO TO 9
03400		IF(IA.EQ.'X')GO TO 8
03455		KJ=KJ+1
03480		MM(KM)=KJ-KM
03500		KN=KN+1
03600		ITOP(KN)=KJ
03700		GO TO 14
03800	9	KJ=ITOP(KN)-1
03900		GO TO 14
04000	8	TYPE 1
04100		ACCEPT 2,NM
04200		CALL OFILE(1,NM)
04300		WRITE(1,10),ITOP
04400	10	FORMAT(' 9999 ',10I5)
04500		M=1
04600	11	M=M+1
04700		J=ITOP(M-1)
04800		K=ITOP(M)-1
04900		IF(K)GO TO 12
05000	C  0=END
05100		N=1
05200		DO 13 JJ=J,K
05300		N=N+1
05400	13	IB(N)=MM(JJ)
05500		IB(1)=N
05600		CALL SAVE(IB)
05700		GO TO 11
05750		END FILE 1
05800	12	END
05900	
06000		SUBROUTINE SAVE(M)
06100		DIMENSION M(1)
06200		J=7
06300		L=8
06400		DO 12 K=1,M(1),8
06500		IF(K+J.LT.M(1))GO TO 12
06600		J=M(1)-K
06700		L=J+1
06800	12	WRITE(1,11)L,(M(NM),NM=K,K+J)
06900		RETURN
07000	11	FORMAT(' 9999',I3,8I10)
07100		END
07200	
07300		SUBROUTINE REPACK(K,M,N,I)
07400		COMMON/LL/L
07500		DIMENSION I(1)
07600		M=M*10000
07700		IF(M)M=10000000-M
07800		IF(N)N=1000-N
07900		M=M+L
08000		I(K)=M+N
08100		RETURN
08200		END